home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM B4 / PD-ROM B4.iso / Utilities / Text and Speech / Alpha 5.3 / Tcl / SystemCode / procs.tcl < prev    next >
Encoding:
Text File  |  1993-02-03  |  9.4 KB  |  434 lines  |  [TEXT/ALFA]
  1. # 'pete' is used in the rest of the file to determine if this is we
  2. # are sitting on someone else's disk.
  3. set pete [expr [file exists "Internal:C:Alpha:Alpha"]?1:0]
  4. set Tcl [expr {$pete ? {Internal:C:Alpha:Tcl 6.2} : "$HOME"}]
  5.  
  6. #===============================================================================================
  7. # Appends all the 'noGlobNecessary' elements with globs of 'globNecessary' elements to create
  8. # the penultimate list file sets. Also calls Alpha and tells it the new list of file set names.
  9. # It is easy to create large filesets by using the 'glob' Tcl command. All that is really 
  10. # necessary is to provide Alpha with a list of fileset names and a way to retrieve the contents
  11. # of a given fileset.
  12. #===============================================================================================
  13.  
  14.  
  15. if ($pete) {
  16.     set globNecessary {
  17.         {Edit "$HOME:EditSource:*.c"}}
  18.     set noGlobNecessary { 
  19.         { Alpha 
  20.             "$HOME:EditSource:emacs.c"
  21.             "$HOME:EditSource:dir.c"
  22.             "$HOME:EditSource:alloca.c"
  23.             "$HOME:EditSource:bindings.c"
  24.             "$HOME:EditSource:command.c"
  25.             "$HOME:EditSource:file_set.c"
  26.             "$HOME:EditSource:search.c"
  27.             "$HOME:EditSource:text.c"
  28.             "$HOME:EditSource:undo.c"
  29.             "$HOME:EditSource:varargs.c"
  30.             "$HOME:EditSource:windows.c"
  31.             "$HOME:EditSource:dirT.c"
  32.             "$HOME:EditSource:frills.c"
  33.             "$HOME:EditSource:io.c"
  34.             "$HOME:EditSource:key.c"
  35.             "$HOME:EditSource:localTcl.c"
  36.             "$HOME:EditSource:moreTcl.c"
  37.             "$HOME:EditSource:shell.c"
  38.             "$HOME:EditSource:main.c"
  39.             "$HOME:EditSource:misc.c"
  40.             "$HOME:EditSource:options.c"
  41.             "$HOME:EditSource:port.c"
  42.             "$HOME:EditSource:redraw.c"
  43.             "$HOME:EditSource:alfRegexp.c"
  44.             "$HOME:EditSource:wmanager.c"
  45.             "$Tcl:panic.c"
  46.             "$Tcl:tclMac.c"
  47.             "$Tcl:tclMacUtil.c"
  48.             "$Tcl:tclAssem.c"
  49.             "$Tcl:tclBasic.c"
  50.             "$Tcl:tclCkalloc.c"
  51.             "$Tcl:tclCmdAH.c"
  52.             "$Tcl:tclCmdIL.c"
  53.             "$Tcl:tclCmdMZ.c"
  54.             "$Tcl:tclEnv.c"
  55.             "$Tcl:tclExpr.c"
  56.             "$Tcl:tclGet.c"
  57.             "$Tcl:tclGlob.c"
  58.             "$Tcl:tclHash.c"
  59.             "$Tcl:tclHistory.c"
  60.             "$Tcl:tclParse.c"
  61.             "$Tcl:tclProc.c"
  62.             "$Tcl:tclUnixAZ.c"
  63.             "$Tcl:tclUnixStr.c"
  64.             "$Tcl:tclUnixUtil.c"
  65.             "$Tcl:tclUtil.c"
  66.             "$Tcl:tclVar.c"
  67.         }
  68.     }
  69. } else {
  70.     set globNecessary {
  71.         {HomeDir "$HOME:*"}
  72.         {Help "$HOME:Help:*"}
  73.     }
  74.     
  75.     set noGlobNecessary {
  76.         { AlternateHome
  77.             "$HOME:AlphaBits.tcl"
  78.             "$HOME:procs.tcl"}
  79.         { AlternateHelp
  80.             "Alpha Help"
  81.             "Alpha Tcl Extensions"
  82.             "Debugging"
  83.             "keyboard.tex"
  84.             "LaTeX Keys"
  85.             "Regular Expressions"
  86.             "Shells"
  87.             "Tcl"
  88.         }
  89.     }
  90. }
  91.  
  92. # This list takes a string and returns the string w/ all occurances
  93. # of the variable 'HOME' substituted. To work this trick w/ other 
  94. # variables, just declare them as global in the following.
  95. # This routine creates the final fileset list from 'globNecessary' 
  96. # 'noGlobNecessary'. Typically only run at startup.
  97. proc expandFileSets {} {
  98.     global fileSets
  99.     global fileSetNames
  100.     global currFileSet
  101.     global globNecessary
  102.     global noGlobNecessary
  103.  
  104.     uplevel #0 {set globNecessary [substituteVars $globNecessary]}
  105.     uplevel #0 {set noGlobNecessary [substituteVars $noGlobNecessary]}
  106.  
  107.     set fileSets {}
  108.     set fileSetNames {}
  109.     
  110.     foreach item $globNecessary {
  111.         lappend fileSets [linsert [glob [lindex $item 1]] 0 [lindex $item 0]]
  112.         lappend fileSetNames [lindex $item 0]
  113.     }
  114.     foreach item $noGlobNecessary {
  115.         lappend fileSets $item
  116.         lappend fileSetNames [lindex $item 0]
  117.     }
  118.  
  119.     menu -n fileSets -m -p changeFileSet $fileSetNames
  120.     if {[catch {[set currFileSet]}] == "1"} {
  121.         set currFileSet [lindex $fileSetNames 0]
  122.     }
  123. }
  124. if {[catch expandFileSets]} {alertnote "Fileset expansion went wrong."}
  125.  
  126. # Called from Alpha to get list of files for current file set.
  127. proc getCurrFileSet {} {
  128.     global fileSets
  129.     global currFileSet
  130.     foreach set $fileSets {
  131.         if {$currFileSet == [lindex $set 0]} {
  132.             return [lrange $set 1 end]
  133.         }
  134.     }
  135.     error "Unable to find valid file set!"
  136. }
  137.  
  138. # Called from Alpha to get names.
  139. proc getFileSetNames {} {
  140.     global fileSetNames
  141.     return $fileSetNames
  142. }
  143.  
  144. #==============================================================================
  145. proc normalLeftBracket {} {
  146.     insertText "\{"
  147. }
  148. proc normalRightBracket {} {
  149.     insertText "\}"
  150. }
  151. bind '\[' <zs>  normalLeftBracket
  152. bind '\]' <zs>  normalRightBracket
  153. #==============================================================================
  154.  
  155.             
  156. # Select the next or current word. If word already selected, will go to next.
  157. proc hiliteWord {} {
  158.     if {[getPos]!=[selEnd]}    forwardChar
  159.     forwardWord
  160.     set start [getPos]
  161.     backwardWord
  162.     select $start [getPos]
  163. }
  164.  
  165. bind 'h' <z> hiliteWord
  166.  
  167. # For mark stack.
  168. set markName 0
  169. set markStack ""
  170.  
  171.  
  172. #=============================================================================
  173. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  174. #                          "suspendHook", and "resumeHook".
  175. #=============================================================================
  176.  
  177. # Event hooks - set specific modes when files opened.
  178. proc openHook name {
  179.     hookMode $name
  180.     if {$name == {*mpw shell*}} startMPW
  181.     addWinName $name
  182. }
  183.  
  184. # Clean up the mark stack.
  185. proc closeHook name {
  186.     global markStack
  187.     if [llength $markStack] {
  188.         set markStack [removePat $markStack $name*]
  189.     }
  190.     removeWinName $name
  191. }
  192.  
  193. proc saveasHook {oldName newName} {
  194.     removeWinName $oldName
  195.     addWinName $newName
  196. }
  197.  
  198.  
  199. proc activateHook name {
  200.     hookMode $name
  201. }
  202.  
  203. proc hookMode name {
  204.     case $name in {
  205.         "*.c"         setCMode
  206.         "*.cc"        setC++Mode
  207.         "*.C"        setC++Mode
  208.         "*.h"         setCMode
  209.         "*.f"          setFortranMode
  210.         "*.tcl"     setTclMode
  211.         {*mpw\ sh*}    setMPWMode
  212.         {*tcl\ sh*}    setShellMode
  213.         "*.tex"        setTexMode
  214.         "*.sty"        setTexMode
  215.         default        setTextMode
  216.     }
  217. }
  218.  
  219.  
  220. # 'modes' is inspected by alpha for the popup mode menu. 'newMode' is 
  221. # called by Alpha in case of a successful choice.
  222. set modes { C C++ Csh Fort MPW Tcl Tex Text }
  223. proc newMode mode {
  224.     case $mode in {
  225.         "C"         setCMode
  226.         "C++"        setC++Mode
  227.         "Csh"         setShellMode
  228.         "Fort"         setFortranMode
  229.         "MPW"        setMPWMode
  230.         "Tcl"         setTclMode
  231.         "Tex"        setTexMode
  232.         "Text"        setTextMode
  233.     }
  234. }
  235.  
  236.  
  237. proc deactivateHook name {
  238. }
  239.  
  240. proc suspendHook name {
  241.     global iconifyOnSwitch
  242.     if {$iconifyOnSwitch} {
  243.         set wins [winNames -f]
  244.         foreach win $wins {
  245.             icon -f $win -c
  246.         }
  247.     }
  248. }
  249.  
  250. proc resumeHook name {
  251.     global iconifyOnSwitch
  252.     if {$iconifyOnSwitch} {
  253.         set wins [winNames -f]
  254.         foreach win $wins {
  255.             icon -f $win -o
  256.         }
  257.     }
  258. }
  259.  
  260. # Handles dynamically adding and deleting window names from menu.
  261. proc addWinName name {
  262.     global winNameToNum
  263.     global winNumToName
  264.     global fullNames
  265.     
  266.     for {set i 0} {$i<100} {incr i} {
  267.         if {[catch {set nm $winNumToName($i)} res] == "1"} {
  268.             if {$fullNames != "0"} {
  269.                 set nm $name
  270.             } else {
  271.                 regexp {[^:]*$} $name nm
  272.             }
  273.             if {$i < 10} {
  274.                 addMenuItem -m -l "/$i" Wins $nm
  275.             } else {
  276.                 addMenuItem -m -l "" Wins $nm
  277.             }
  278.             set winNumToName($i) $name
  279.             set winNameToNum($name) $i
  280.             return
  281.         }
  282.     }
  283. }
  284.  
  285. proc removeWinName name {
  286.     global winNameToNum
  287.     global winNumToName
  288.     global fullNames
  289.     
  290.     set num $winNameToNum($name)
  291.     unset winNumToName($num)
  292.     unset winNameToNum($name)
  293.     if {$fullNames == "1"} {
  294.         deleteMenuItem -m Wins $name
  295.     } else {
  296.         regexp {[^:]*$} $name nm
  297.         deleteMenuItem -m Wins $nm
  298.     }
  299. }
  300.  
  301.  
  302. proc menuWin {menu name} {
  303.     global winNameToNum
  304.  
  305.     set nms [array names winNameToNum]
  306.     foreach nm $nms {
  307.         if {[string match *$name $nm] == "1"}  {
  308.             bringToFront $name
  309.             return
  310.         }
  311.     }
  312.     return "normal"
  313. }
  314.  
  315.  
  316. set lastMode 0
  317.  
  318. # rta  Creating texWasLast variable
  319. set texWasLast 0
  320. # rta Following changed from ThinkC to MPW
  321.  
  322.  
  323. # Modes
  324.  
  325. # Fortran programming mode 
  326. proc setFortranMode {} {
  327.     changeMode "Fort"
  328.     uplevel #0 {
  329.         set elecLBrace 0
  330.         set elecRBrace 0
  331.         set electricSemi 0
  332.         set wordWrap 0
  333.         set funcExpr {^(      |\t)(subroutine|.*function|SUBROUTINE|.*FUNCTION).*\(.*$}
  334.         set sortedIsDefault 0
  335.         set funcTitle "Func"
  336.     }
  337. }
  338.  
  339.  
  340. # Alpha TCL programming mode
  341. menu -n Tcl {
  342.     "traceTclProc"
  343.     "traceOff"
  344. }
  345.  
  346. # LaTeX mode
  347. proc setTexMode {} {
  348.     changeMode "Tex"
  349.     uplevel #0 {    
  350.         set wordBreakPreface {[^a-zA-Z0-9_]}
  351.         set wordBreak {[a-zA-Z0-9_]+}
  352.         set elecLBrace 0
  353.         set elecRBrace 0
  354.         set electricSemi 0
  355.         set wordWrap 1
  356.         set fillColumn 75
  357.         set prefixString "% "
  358.         set funcTitle "Sect"
  359.         set sortedIsDefault 0
  360.         set funcExpr {^\\(sub)*section\*?{([^{}]*)}}
  361. #        set funcExpr {^\\(sub)*section\*?{(.*)}$}
  362.         set funcPar 2
  363.         set savedIsMeta $optionIsMeta
  364. #        Comment out next line (put "#" in column 0) to use option key 
  365. #       as meta and bind LaTeX macros to option-control in Tex mode.
  366.         if {!$pete} {set optionIsMeta 0}
  367. #        Next is a call to a random proc in the latex file to make sure
  368. #        is it auto-loaded.
  369.         isSelection
  370.         insertMenu "LaTeX"
  371.     }
  372. }
  373.  
  374.  
  375. # Ordinary, default mode
  376. proc setTextMode {} {
  377.     changeMode "Text"
  378.     uplevel #0 {
  379.         set elecLBrace 0
  380.         set elecRBrace 0
  381.         set electricSemi 0
  382.         set wordWrap 1
  383.         set fillColumn 75
  384.         set prefixString "> "
  385.         set suffixString " <--"
  386.     }
  387. }
  388.  
  389.  
  390. proc changeMode {newMode} {
  391.     global lastMode
  392.     global savedIsMeta
  393.     global wordBreak
  394.     global wordBreakPreface
  395.     global optionIsMeta
  396.     
  397.     if {$lastMode == $newMode} {
  398.         displayMode $newMode
  399.         return
  400.     }
  401.     
  402.     displayMode $newMode
  403.     case $lastMode in {
  404.         "Tex" {
  405.             set optionIsMeta $savedIsMeta
  406.             set wordBreakPreface {[^a-zA-Z0-9_]}
  407.             set wordBreak {[a-zA-Z0-9_]+}
  408.             set wordBreak {[a-zA-Z0-9_]+}
  409.             removeMenu "LaTeX"
  410.             set optionIsMeta 1
  411.         }
  412.         "Tcl" {
  413.             removeMenu "Tcl"
  414.         }
  415.     }
  416.     if {[string length $lastMode]} {enableMenuItem Modes $lastMode on}
  417.     enableMenuItem Modes $newMode off
  418.     global mode
  419.     set mode $newMode
  420.     set lastMode $newMode
  421. }
  422.     
  423.  
  424. proc alphaHelp {} {
  425.     global HOME
  426.     edit -r -m "$HOME:Help:Alpha Help"
  427. }
  428.  
  429.  
  430. set patternLibrary {
  431.     { "Pascal to C Comments" {\{([^\}]*)\}} {/* \1 */} }
  432.     { "C++ to C Comments" {//(.*)} {/* \1 */}}
  433. }
  434.